20TJ

Technical details

Show code
library(GeoPressureR)
library(leaflet)
library(leaflet.extras)
library(raster)
library(dplyr)
library(ggplot2)
library(kableExtra)
library(plotly)
library(GeoLocTools)
setupGeolocation()
knitr::opts_chunk$set(echo = FALSE)
load(paste0("../data/1_pressure/", params$gdl_id, "_pressure_prob.Rdata"))
load(paste0("../data/2_light/", params$gdl_id, "_light_prob.Rdata"))
load(paste0("../data/3_static/", params$gdl_id, "_static_prob.Rdata"))
load(paste0("../data/4_basic_graph/", params$gdl_id, "_basic_graph.Rdata"))
load(paste0("../data/5_wind_graph/", params$gdl_id, "_wind_graph.Rdata"))
col <- rep(RColorBrewer::brewer.pal(8, "Dark2"), times = ceiling(max(pam$sta$sta_id) / 8))

Settings used

All the results produced here are generated with (1) the raw geolocator data, (2) the labeled files of pressure and light and (3) the parameters listed below.

Show code
kable(gpr) %>% scroll_box(width = "100%")
gdl_id keep crop_start crop_end thr_dur extent_N extent_W extent_S extent_E map_scale map_max_sample map_margin prob_map_s prob_map_s_calib prob_map_thr shift_k kernel_adjust calib_lon calib_lat calib_1_start calib_1_end calib_2_start calib_2_end calib_2_lon calib_2_lat prob_light_w thr_prob_percentile thr_gs thr_as RingNo scientific_name common_name mass wing_span Color sta_id_winter
20TJ 2 2018-08-01 2018-11-08 05:50:00 0 51 -18 5 16 4 300 30 1 1.3 0.9 0 1.4 8.703374 46.55014 2018-08-01 2018-09-11 NA NA NA NA 0.09 0.95 120 100 N566688 Oenanthe oenanthe Northern wheatear NA NA #B6E880 12

Pressure timeserie

The labeling of pressure data is illustrated with this figure. The black dots indicates the pressure datapoint not considered in the matching. Each stationary period is illustrated by a different colored line.

Show code
pressure_na <- pam$pressure %>%
  mutate(obs = ifelse(isoutlier | sta_id == 0, NA, obs))
p <- ggplot() +
  geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  # geom_point(data = subset(pam$pressure, isoutlier), aes(x = date, y = obs), colour = "black") +
  # geom_line(data = pressure_na, aes(x = date, y = obs, color = factor(sta_id)), size = 0.5) +
  geom_line(data = do.call("rbind", shortest_path_timeserie) %>% filter(sta_id > 0), aes(x = date, y = pressure0, col = factor(sta_id))) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Pressure(hPa)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Pressure calibration

Show code
pressure_ts_bind <- do.call("rbind", shortest_path_timeserie) %>%
  filter(!is.na(sta_id))

pam$pressure %>%
  left_join(pressure_ts_bind %>% dplyr::select(c("date", "pressure0")), by = "date") %>%
  mutate(diff = ifelse(is.na(pressure0), 0, obs - pressure0)) %>%
  filter(sta_id > 0 & !isoutlier) %>%
  group_by(sta_id) %>%
  mutate(sta_id = paste0(sta_id, " (SD=", round(sd(diff), 2), " ; N=", n(), ")")) %>%
  ggplot(aes(x = diff)) +
  geom_histogram(aes(y = (..count..) / tapply(..count.., ..PANEL.., sum)[..PANEL..]), binwidth = .2) +
  facet_wrap(~sta_id) +
  scale_x_continuous(name = "Pressure Geolocator - best match ERA5 (hPa)") +
  scale_y_continuous(name = "Normalized histogram")

Light

Show code
raw_geolight <- pam$light %>%
  transmute(
    Date = date,
    Light = obs
  )
lightImage(tagdata = raw_geolight, offset = 0)
tsimagePoints(twl$twilight,
  offset = 0, pch = 16, cex = 1.2,
  col = ifelse(twl$deleted, "grey20", ifelse(twl$rise, "firebrick", "cornflowerblue"))
)
abline(v = gpr$calib_2_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_2_end, lty = 2, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_end, lty = 2, col = "firebrick", lwd = 1.5)

Show code
hist(z, freq = F)
lines(fit_z, col = "red")

The probability map resulting from light data alone can be seen below.

Show code
li_s <- list()
l <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl()
for (i_r in seq_len(length(light_prob))) {
  i_s <- metadata(light_prob[[i_r]])$sta_id
  info <- pam$sta[pam$sta$sta_id == i_s, ]
  info_str <- paste0(i_s, " | ", info$start, "->", info$end)
  li_s <- append(li_s, info_str)
  l <- l %>% addRasterImage(light_prob[[i_r]], opacity = 0.8, colors = "OrRd", group = info_str)
}
l %>%
  addCircles(lng = gpr$calib_lon, lat = gpr$calib_lat, color = "black", opacity = 1) %>%
  addLayersControl(
    overlayGroups = li_s,
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup(tail(li_s, length(li_s) - 1))

Light vs Pressure

We can compare light and pressure location at long stationary stopover (>5 days). By assuming the best match of the pressure to be the truth, we can plot the histogram of the zenith angle and compare to the fit of kernel density at the calibration site.

Show code
 raw_geolight <- pam$light %>%
    transmute(
      Date = date,
      Light = obs
    )
 dur <- unlist(lapply(pressure_prob, function(x) difftime(metadata(x)$temporal_extent[2],metadata(x)$temporal_extent[1], units = "days" )))
  long_id <- which(dur>5)

  par(mfrow = c(2, 3))
  for (i_s in long_id){
    twl_fl <- twl %>%
      filter(!deleted) %>%
      filter(twilight>shortest_path_timeserie[[i_s]]$date[1] & twilight<tail(shortest_path_timeserie[[i_s]]$date,1))
    sun <-  solar(twl_fl$twilight)
    z_i <- refracted(zenith(sun, shortest_path_timeserie[[i_s]]$lon[1], shortest_path_timeserie[[i_s]]$lat[1]))
    hist(z_i, freq = F, main = paste0("sta_id=",i_s, " | ",nrow(twl_fl),"twls"))
    lines(fit_z, col = "red")
    xlab("Zenith angle")
  }

Similarly, we can plot the line of sunrise/sunset at the best match of pressure (yellow line) and compare to the raw and labeled light data.

Show code
  lightImage(
    tagdata = raw_geolight,
    offset = gpr$shift_k / 60 / 60
  )
  tsimagePoints(twl$twilight,
                offset = gpr$shift_k / 60 / 60, pch = 16, cex = 1.2,
                col = ifelse(twl$deleted, "grey20", ifelse(twl$rise, "firebrick", "cornflowerblue"))
  )
  for (ts in shortest_path_timeserie){
    twl_fl <- twl %>%
      filter(twilight>ts$date[1] & twilight<tail(ts$date,1))
    if (nrow(twl_fl)>0){
    tsimageDeploymentLines(twl_fl$twilight,
                           lon = ts$lon[1], ts$lat[1],
                           offset = gpr$shift_k / 60 / 60, lwd = 3,col = adjustcolor("orange", alpha.f = 0.5))
      
    }
  }

Stationay period information

Show code
read_csv(paste0("../reports/figure_print/table_transition/transition_", params$gdl_id, ".csv")) %>% kable() %>% scroll_box(width = "100%")
…1 sta_id_s sta_id_t flight_duration as_m as_s gs_m gs_s ws_m ws_s dist_m dist_s ws_m_support ws_m_drift start_flight end_flight sunrise sunset as_sp gs_sp ws_sp dist_sp ws_sp_support ws_sp_drift alt_min alt_max alt_mean alt_med alt_sumdabsdiff alt_sumposdiff gdl_id
1 1 2 6.5 32.43513 7.689994 39.91235 10.02956 9.269177 2.533759 259.43025 65.19215 7.853152 4.923987 2018-09-10 18:00:00 2018-09-11 00:30:00 2018-09-11 04:35:31 2018-09-10 18:18:06 34.43254 45.32069 10.950318 294.58450 10.903129 1.0155072 1862.10614 4764.1579 3891.7798 4298.2386 6268.2856 3018.5932 20TJ
2 2 3 5.0 39.33389 12.053210 35.81438 12.41859 6.606142 2.561573 179.07188 62.09294 -3.083178 5.842527 2018-09-12 19:00:00 2018-09-13 00:00:00 2018-09-13 04:43:27 2018-09-12 18:16:02 28.35551 22.96060 6.000728 114.80300 -5.244567 2.9160346 144.91843 3853.9612 1937.2728 1687.6263 4593.9686 662.3002 20TJ
3 3 4 9.5 59.99573 13.214048 83.26211 14.02501 24.729876 1.590939 790.99009 133.23760 23.688195 7.101843 2018-09-13 18:30:00 2018-09-14 04:00:00 2018-09-14 04:38:28 2018-09-13 18:18:36 55.54795 80.55483 25.591497 765.27089 25.190486 4.5126604 21.75066 4054.8460 2435.0493 3040.3677 9771.6018 4946.4769 20TJ
4 4 5 4.5 37.60068 17.173692 41.37704 19.75118 9.783523 5.617744 186.19670 88.88032 4.760682 8.547118 2018-09-14 18:30:00 2018-09-14 23:00:00 2018-09-15 04:40:13 2018-09-14 17:59:05 26.37476 30.82453 8.023529 138.71039 5.172840 6.1334120 150.67444 798.1368 462.3851 455.5424 755.6198 701.5411 20TJ
5 5 6 10.5 42.90239 10.306387 43.00580 10.80056 13.591453 2.887570 451.56095 113.40592 2.250991 13.403755 2018-10-06 18:00:00 2018-10-07 04:30:00 2018-10-07 05:00:41 2018-10-06 17:25:55 40.38932 45.75348 10.392652 480.41156 6.230034 8.3182864 171.34883 2520.2774 1439.1285 1405.2512 6230.0917 2759.4391 20TJ
6 6 7 11.5 49.86674 15.224406 63.21378 13.95020 14.037287 2.298830 726.95844 160.42733 13.496546 3.858584 2018-10-07 17:30:00 2018-10-08 05:00:00 2018-10-08 05:09:02 2018-10-07 17:29:32 35.17941 49.57066 14.778768 570.06264 14.505270 2.8300437 120.44313 2839.8466 2067.8788 2237.9434 5747.2758 3190.7611 20TJ
7 7 8 11.0 33.96273 14.420341 47.58598 13.88443 16.945471 3.924526 523.44577 152.72870 14.690330 8.446489 2018-10-08 17:30:00 2018-10-09 04:30:00 2018-10-09 05:18:15 2018-10-08 17:38:40 29.50622 46.36382 16.862586 510.00204 16.859416 0.3269645 773.41362 2897.8323 1326.7617 1220.6917 6441.5637 3335.3866 20TJ
8 8 9 11.0 40.49808 14.624979 50.43056 15.05772 15.490626 5.113244 554.73619 165.63493 11.333474 10.559917 2018-10-09 18:00:00 2018-10-10 05:00:00 2018-10-10 05:25:05 2018-10-09 17:48:58 33.08022 46.77687 15.954814 514.54558 14.412365 6.8439623 461.59257 2527.0318 1163.4740 958.5288 9220.7891 4547.8161 20TJ
9 9 10 3.5 38.85012 15.449402 45.81142 15.38688 11.119153 4.661256 160.33998 53.85407 7.781795 7.942244 2018-10-10 19:30:00 2018-10-10 23:00:00 2018-10-11 05:28:01 2018-10-10 17:57:40 25.14121 32.80365 10.248472 114.81279 8.368438 5.9161145 286.71528 2068.5426 1103.6547 1018.3637 3418.7972 1636.9699 20TJ
10 10 11 1.0 35.00795 16.175639 36.04533 19.09359 14.649945 3.892500 36.04533 19.09359 3.999552 14.093420 2018-10-11 02:30:00 2018-10-11 03:30:00 2018-10-11 05:27:07 2018-10-10 18:00:57 26.18057 38.29653 15.173305 38.29653 13.205258 7.4733074 293.60101 940.7753 517.3558 317.6910 1270.2585 647.1743 20TJ
11 11 12 5.0 30.85021 13.488974 32.58968 14.85545 15.198543 8.343992 162.94839 74.27724 5.237049 14.267762 2018-10-11 21:00:00 2018-10-12 02:00:00 2018-10-12 05:25:35 2018-10-11 17:59:07 25.58039 39.09843 18.883801 195.49213 15.741407 10.4310135 280.05243 1706.7967 804.9680 838.2029 5043.5970 2563.5318 20TJ